home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MATH.SWG / 0005_GAUSS.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  16KB  |  410 lines
  1. Program Gauss_Elimination;
  2.  
  3. Uses Crt,Printer;
  4.  
  5. (***************************************************************************)
  6. (* STEPHEN ABRAHAM                                                         *)
  7. (* MCEN 3030 Comp METHODS                                                  *)
  8. (* ASSGN #3                                                                *)
  9. (* DUE: 2-12-93                                                            *)
  10. (*                                                                         *)
  11. (* GAUSS ELIMinATION (TURBO PASCAL VERSION by STEPHEN ABRAHAM)             *)
  12. (*                                                                         *)
  13. (***************************************************************************)
  14. {                                                                           }
  15. {                                                                           }
  16. {------------------VarIABLE DECLARATION and  DEFinITIONS--------------------}
  17.  
  18. Const
  19.   MAXROW = 50; (* Maximum # of rows in a matrix    *)
  20.   MAXCOL = 50; (* Maximum # of columns in a matrix *)
  21.  
  22. Type
  23.   Mat_Array = Array[1..MAXROW,1..MAXCOL] of Real; (* 2-D Matrix of Reals *)
  24.   Col_Array = Array[1..MAXCOL] of Real; (* 1-D Matrix of Real numbers    *)
  25.   Int_Array = Array[1..MAXCOL] of Integer; (* 1-D Matrix of Integers     *)
  26.  
  27. Var
  28.   N_EQNS      : Integer;   (* User Input : Number of equations in system  *)
  29.   COEFF_MAT   : Mat_Array; (* User Input : Coefficient Matrix of system   *)
  30.   COL_MAT     : Col_Array; (* User Input : Column matrix of Constants     *)
  31.   X_MAT       : Col_Array; (* OutPut : Solution matrix For unknowns       *)
  32.   orDER_VECT  : Int_Array; (* Defined to pivot rows where necessary       *)
  33.   SCALE_VECT  : Col_Array; (* Defined to divide by largest element in     *)
  34.                            (* row For normalizing effect                  *)
  35.   I,J,K       : Integer;   (* Loop control and Array subscripts           *)
  36.   Ans         : Char;      (* Yes/No response to check inputted matrix    *)
  37.  
  38.  
  39. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  40.  
  41.  
  42.  
  43. {^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^}
  44. {>>>>>>>>>>>>>>>>>>>>>>>>>   ProcedureS    <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<}
  45. {...........................................................................}
  46.  
  47.  
  48. Procedure Home;  (* clears screen and positions cursor at (1,1)            *)
  49. begin
  50.    ClrScr;
  51.    GotoXY(1,1);
  52. end; (* Procedure Home *)
  53.  
  54. {---------------------------------------------------------------------------}
  55.  
  56.  
  57. Procedure Instruct;  (* provides user instructions if wanted               *)
  58.  
  59. Var
  60.   Ans : Char;  (* Yes/No answer by user For instructions or not            *)
  61.  
  62. begin
  63.    Home; (* calls Home Procedure *)
  64.    GotoXY(22,8); Writeln('STEVE`S GAUSSIAN ELIMinATION Program');
  65.    GotoXY(36,10); Writeln('2-12-92');
  66.    GotoXY(31,18); Write('Instructions(Y/N):');
  67.    GotoXY(31,49); readln(Ans);
  68.    if Ans in ['Y','y'] then
  69.    begin
  70.      Home; (* calls Home Procedure *)
  71.      Writeln('  Welcome to Steve`s Gaussian elimination Program.  With this');
  72.      Writeln('Program you will be able to enter the augmented matrix of    ');
  73.      Writeln('your system of liNear equations and have returned to you the ');
  74.      Writeln('solutions For each unknown.  The Computer will ask you to    ');
  75.      Writeln('input the number of equations in your system and will then   ');
  76.      Writeln('have you input your coefficient matrix and then your column  ');
  77.      Writeln('matrix.  Please remember For n unknowns, you will need to    ');
  78.      Writeln('have n equations.  ThereFore you should be entering a square ');
  79.      Writeln('(nxn) coefficient matrix.  Have FUN!!!!                      ');
  80.      Writeln('(hit <enter> to continue...)');  (* Delay *)
  81.      readln;
  82.    end;
  83. end;
  84.  
  85.  
  86. {---------------------------------------------------------------------------}
  87.  
  88.  
  89. Procedure Initialize_Array( Var Coeff_Mat : Mat_Array ;
  90.                             Var Col_Mat,X_Mat, Scale_Vect : Col_Array;
  91.                             Var order_Vect : Int_Array);
  92.  
  93. (*** This Procedure initializes all matrices to be used in Program       ***)
  94. (*** ON ENTRY : Matrices have undefined values in them                   ***)
  95. (*** ON Exit  : All Matrices are zero matrices                           ***)
  96.  
  97.  
  98. Const
  99.   MAXROW = 50; { maximum # of rows in matrix    }
  100.   MAXCOL = 50; { maximum # of columns in matrix }
  101.  
  102. Var
  103.   I : Integer; { I & J are both loop control and Array subscripts }
  104.   J : Integer;
  105.  
  106. begin
  107.   For I :=  1 to MaxRow do   { row indices }
  108.   begin
  109.     Col_Mat[I]    := 0;
  110.     X_Mat[I]      := 0;
  111.     order_Vect[I] := 0;
  112.     Scale_Vect[I] := 0;
  113.     For J := 1 to MaxCol do   { column indices }
  114.       Coeff_Mat[I,J] := 0;
  115.   end;
  116. end; (* Procedure initialize_Array *)
  117.  
  118.  
  119. {---------------------------------------------------------------------------}
  120.  
  121. Procedure Input(Var N : Integer;
  122.                 Var Coeff_Mat1 : Mat_Array;
  123.                 Var Col_Mat1 : Col_Array);
  124.  
  125. (*** This Procedure lets the user input the number of equations and the  ***)
  126. (*** augmented matrix of their system of equations                       ***)
  127. (*** ON ENTRY : N => number of equations : UNDEFinED
  128.                 Coeff_Mat1 => coefficient matrix : UNDEFinED
  129.                 Col_Mat1 => column matrix :UNDEFinED
  130.      ON Exit  : N => # of equations input by user
  131.                 Coeff_Mat1 => defined coefficient matrix
  132.                 Col_Mat1 => defined column matrix input by user          ***)
  133.  
  134.  
  135.  
  136. Var
  137.   I,J : Integer;  (* loop control and Array indices *)
  138.  
  139. begin
  140.   Home; (* calls Procedure Home *)
  141.   Write('Enter the number of equations in your system: ');
  142.   readln(N);
  143.   Writeln;
  144.   Writeln('Now you will enter your coefficient and column matrix:');
  145.   For I := 1 to N do     { row indice }
  146.   begin
  147.     Writeln('ROW #',I);
  148.     For J := 1 to N do   {column indice }
  149.     begin
  150.       Write('a(',I,',',J,'):');
  151.       readln(Coeff_Mat1[I,J]);    {input of coefficient matrix}
  152.     end;
  153.     Write('c(',I,'):');
  154.     readln(Col_Mat1[I]);          {input of Constant matrix}
  155.   end;
  156.   readln;
  157. end;  (* Procedure Input *)
  158.  
  159.  
  160. {---------------------------------------------------------------------------}
  161.  
  162.  
  163. Procedure Check_Input( Coeff_Mat1 : Mat_Array;
  164.                           N : Integer; Var Ans : Char);
  165.  
  166. (*** This Procedure displays the user's input matrix and asks if it is  ***)
  167. (*** correct.                                                           ***)
  168. (*** ON ENTRY : Coeff_Mat1 => inputted matrix
  169.                 N => inputted number of equations
  170.                 Ans => UNDEFinED                                        ***)
  171. (*** ON Exit  : Coeff_Mat1 => n/a
  172.                 N => n/a
  173.                 Ans => Y,y or N,n                                       ***)
  174.  
  175.  
  176. Var
  177.   I,J   : Integer;  (* loop control and Array indices *)
  178.  
  179. begin
  180.   Home; (* calls Home Procedure *)
  181.   Writeln; Writeln('Your inputted augmented matrix is:');Writeln;Writeln;
  182.  
  183.   For I := 1 to N do   { row indice }
  184.   begin
  185.     For J := 1 to N do { column indice }
  186.       Write(Coeff_Mat[I,J]:12:4);
  187.     Writeln(Col_Mat[I]:12:4);
  188.   end;
  189.   Writeln; Write('Is this your desired matrix?(Y/N):'); (* Gets Answer *)
  190.   readln(Ans);
  191. end;  (* Procedure Check_Input *)
  192.  
  193.  
  194. {---------------------------------------------------------------------------}
  195.  
  196.  
  197. Procedure order(Var Scale_Vect1 : Col_Array;
  198.                 Var order_Vect1 : Int_Array;
  199.                 Var Coeff_Mat1  : Mat_Array;
  200.                     N           : Integer);
  201.  
  202. (*** This Procedure finds the order and scaling value For each row of the
  203.      inputted coefficient matrix.                                        ***)
  204. (*** ON ENTRY : Scale_Vect1 => UNDEFinED
  205.                 order_Vect1 => UNDEFinED
  206.                 Coeff_Mat1  => as inputted
  207.                 N           => # of equations
  208.      ON Exit  : Scale_Vect1 => contains highest value For each row of the
  209.                                coefficient matrix
  210.                 order_Vect1 => is assigned the row number of each row from
  211.                                the coefficient matrix in order
  212.                 Coeff_Mat   => n/a
  213.                 N           => n/a                                      ***)
  214.  
  215.  
  216. Var
  217.   I,J : Integer;  {loop control and Array indices}
  218.  
  219. begin
  220. For I := 1 to N do
  221.   begin
  222.     order_Vect1[I] := I;  (* ordervect gets the row number of each row *)
  223.     Scale_Vect1[I] := Abs(Coeff_Mat1[I,1]); (* gets the first number of each row *)
  224.     For J := 2 to N do { goes through the columns }
  225.       begin  (* Compares values in each row of the coefficient matrix and
  226.                 stores this value in scale_vect[i] *)
  227.         if Abs(Coeff_Mat1[I,J]) > Scale_Vect1[I] then
  228.            Scale_Vect1[I] := Abs(Coeff_Mat1[I,J]);
  229.       end;
  230.   end;
  231. end;  (* Procedure order *)
  232.  
  233.  
  234. {---------------------------------------------------------------------------}
  235.  
  236.  
  237. Procedure Pivot(Var Scale_Vect1 : Col_Array;
  238.                     Coeff_Mat1  : Mat_Array;
  239.                 Var order_Vect1 : Int_Array;
  240.                     K,N         : Integer);
  241.  
  242. (*** This Procedure finds the largest number in each column after it has been
  243.      scaled and Compares it With the number in the corresponding diagonal
  244.      position. For example, in column one, a(1,1) is divided by the scaling
  245.      factor of row one. then each value in the matrix that is in column one
  246.      is divided by its own row's scaling vector and Compared With the
  247.      position above it. So a(1,1)/scalevect[1] is Compared to a[2,1]/scalevect[2]
  248.      and which ever is greater has its row number stored as pivot. Once the
  249.      highest value For a column is found, rows will be switched so that the
  250.      leading position has the highest possible value after being scaled. ***)
  251.  
  252. (*** ON ENTRY : Scale_Vect1 => the normalizing value of each row
  253.                 Coeff_Mat1  => the inputted coefficient matrix
  254.                 order_Vect1 => the row number of each row in original order
  255.                 K           => passed in from the eliminate Procedure
  256.                 N           => number of equations
  257.      ON Exit  : Scale_Vect  => same
  258.                 Coeff_Mat1  => same
  259.                 order_Vect  => contains the row number With highest scaled
  260.                                value
  261.                 k           => n/a
  262.                 N           => n/a                                      ***)
  263.  
  264. Var
  265.   I           : Integer; {loop control and Array indice }
  266.   Pivot, Idum : Integer; {holds temporary values For pivoting }
  267.   Big,Dummy   : Real; {used to Compare values of each column }
  268. begin
  269.   Pivot := K;
  270.   Big := Abs(Coeff_Mat1[order_Vect1[K],K]/Scale_Vect1[order_Vect1[K]]);
  271.   For I := K+1 to N do
  272.     begin
  273.     Dummy := Abs(Coeff_Mat1[order_Vect1[I],K]/Scale_Vect1[order_Vect1[I]]);
  274.     if Dummy > Big then
  275.     begin
  276.       Big := Dummy;
  277.       Pivot := I;
  278.     end;
  279.     end;
  280.   Idum := order_Vect1[Pivot];              { switching routine }
  281.   order_Vect1[Pivot] := order_Vect1[K];
  282.   order_Vect1[K] := Idum;
  283. end; { Procedure pivot }
  284.  
  285.  
  286. {---------------------------------------------------------------------------}
  287.  
  288. Procedure Eliminate(Var Col_Mat1, Scale_Vect1 : Col_Array;
  289.                     Var Coeff_Mat1 : Mat_Array;
  290.                     Var order_Vect1 : Int_Array;
  291.                     N : Integer);
  292.  
  293.  
  294. Var
  295.   I,J,K       : Integer;
  296.   Factor      : Real;
  297.  
  298. begin
  299.  For K := 1 to N-1 do
  300.  begin
  301.    Pivot (Scale_Vect1,Coeff_Mat1,order_Vect1,K,N);
  302.    For I := K+1 to N do
  303.    begin
  304.      Factor := Coeff_Mat1[order_Vect1[I],K]/Coeff_Mat1[order_Vect1[K],K];
  305.      For J := K+1 to N do
  306.      begin
  307.        Coeff_Mat1[order_Vect1[I],J] := Coeff_Mat1[order_Vect1[I],J] -
  308.                                         Factor*Coeff_Mat1[order_Vect1[K],J];
  309.      end;
  310.    Col_Mat1[order_Vect1[I]] := Col_Mat1[order_Vect1[I]] - Factor*Col_Mat1[order_Vect1[K]];
  311.    end;
  312.  end;
  313. end;
  314.  
  315.  
  316. {---------------------------------------------------------------------------}
  317.  
  318.  
  319. Procedure Substitute(Var Col_Mat1, X_Mat1 : Col_Array;
  320.                          Coeff_Mat1 : Mat_Array;
  321.                      Var order_Vect1 : Int_Array;
  322.                      N : Integer);
  323.  
  324. (*** This Procedure will backsubstitute to find the solutions to your
  325.      system of liNear equations.
  326.      ON ENTRY : Col_Mat => your modified Constant column matrix
  327.                 X_Mat1  => UNDEFinED
  328.                 Coeff_Mat1 => modified into upper triangular matrix
  329.                 order_Vect => contains the order of your rows
  330.                 N          => number of equations
  331.      ON Exit  : Col_Mat => n/a
  332.                 X_MAt1  => your solutions !!!!!!!!!!!!!
  333.                 Coeff_Mat1 => n/a
  334.                 order_Vect1 => who cares
  335.                 N           => n/a                                      ***)
  336.  
  337.  
  338. Var
  339.   I, J  : Integer; (* loop and indice of Array control *)
  340.   Sum   : Real;    (* used to sum each row's elements *)
  341.  
  342. begin
  343.   X_Mat1[N] := Col_Mat1[order_Vect1[N]]/Coeff_Mat1[order_Vect1[N],N];
  344.   (***** This gives you the value of x[n] *********)
  345.  
  346.   For I := N-1 downto 1 do
  347.   begin
  348.     Sum := 0.0;
  349.     For J := I+1 to N do
  350.       Sum := Sum + Coeff_Mat1[order_Vect1[I],J]*X_Mat1[J];
  351.     X_Mat1[I] := (Col_Mat1[order_Vect1[I]] - Sum)/Coeff_Mat1[order_Vect1[I],I];
  352.   end;
  353. end;   (** Procedure substitute **)
  354.  
  355.  
  356. {---------------------------------------------------------------------------}
  357.  
  358.  
  359. Procedure Output(X_Mat1: Col_Array; N : Integer);
  360.  
  361. (*** This Procedure outputs the solutions to the inputted system of     ***)
  362. (*** equations                                                          ***)
  363. (*** ON ENTRY : X_Mat1 => the solutions to the system of equations
  364.                 N => the number of equations
  365.      ON Exit  : X_Mat1 => n/a
  366.                 N => n/a                                                ***)
  367.  
  368.  
  369. Var
  370.   I    : Integer; (* loop control and Array indice *)
  371.  
  372. begin
  373.   Writeln;Writeln;Writeln; (* skips lines *)
  374.   Writeln('The solutions to your sytem of equations are:');
  375.   For I := 1 to N do
  376.   Writeln('X(',I,') := ',X_Mat1[I]);
  377. end;   (* Procedure /output *)
  378.  
  379.  
  380.  
  381. {---------------------------------------------------------------------------}
  382. (*                                                                         *)
  383. (*                                                                         *)
  384. (*                                                                         *)
  385. (***************************************************************************)
  386.  
  387. begin
  388.  
  389.   Repeat
  390.     Instruct;  (* calls Procedure Instruct *)
  391.     Initialize_Array(Coeff_Mat, Col_Mat, X_Mat, Scale_Vect, order_Vect);
  392.              (* calls Procedure Initialize_Array *)
  393.     Repeat
  394.       Input(N_EQNS, Coeff_Mat, Col_Mat); (* calls Procedure Input *)
  395.       Check_Input(Coeff_Mat,N_EQNS,Ans); (* calls Procedure check_Input *)
  396.     Until Ans in ['Y','y']; (* loops Until user inputs correct matrix *)
  397.  
  398.     order(Scale_Vect,order_Vect,Coeff_Mat,N_EQNS); (* calls Procedure order *)
  399.     Eliminate(Col_Mat,Scale_Vect,Coeff_Mat,order_Vect,N_EQNS);   (*etc..*)
  400.     Substitute(Col_Mat,X_Mat,Coeff_Mat,order_Vect,N_EQNS);       (*etc..*)
  401.     Output(X_Mat,N_EQNS);                                        (*etc..*)
  402.  
  403.     Writeln;
  404.     Write('Do you wish to solve another system of equations?(Y/N):');
  405.     readln(Ans);
  406.   Until Ans in ['N','n'];
  407.  
  408.  
  409. end. (*************** end of Program GAUSS_ELIMinATION *******************)
  410.